home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / pkey12_1.zip / RS.LSP < prev    next >
Text File  |  1992-09-13  |  1KB  |  32 lines
  1. ;Room Size program ( and naming ) neat !!
  2. ;
  3. ;
  4. (defun c:RS (/ pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
  5. (setq oer *error* *error* err2)
  6. (PROMPT "\n(D)ining room. (S)torage. c(L)oset. ")
  7. (SETQ Cpt(GETSTRING "\n(C)onference. (O)ffice. (K)itchen. (B)ath. (M)aster Bedroom."))
  8. (IF(OR(= Cpt "K")(= cpt "k"))(SETQ CPT '"KITCHEN"))
  9. (IF(OR(= cpt "B")(= cpt "b"))(SETQ CPT '"BATH"))
  10. (IF(OR(= cpt "C")(= cpt "c"))(SETQ CPT '"CONFERENCE"))
  11. (IF(OR(= cpt "O")(= cpt "o"))(SETQ CPT '"OFFICE"))
  12. (IF(OR(= cpt "M")(= cpt "m"))(SETQ CPT '"MASTER BEDROOM"))
  13. (IF(OR(= cpt "D")(= cpt "d"))(SETQ CPT '"DINING ROOM"))
  14. (IF(OR(= cpt "S")(= cpt "s"))(SETQ CPT '"STORAGE"))
  15. (IF(OR(= cpt "L")(= cpt "l"))(SETQ CPT '"CLOSET"))
  16.   (setq pta (getpoint
  17.     "\nPick first corner. : "))
  18.   (setq ptb (getcorner pta
  19.     "\nPick second corner. : "))
  20.   (setq ptc (list (car ptb)(cadr pta)))
  21.   (setq ptd (list (car pta)(cadr ptb)))
  22.   (setq ang (angle pta ptb))
  23.   (setq d1 (/(distance pta ptb) 2))
  24.   (setq cp (polar pta (- ang (dtr 0)) d1))
  25.   (setq X (distance pta ptc))
  26.   (setq Y (distance pta ptd))
  27.   (setq X1 (rtos x 4 0))
  28.   (setq Y1 (rtos y 4 0))
  29.   (setq rmsz (strcat X1 " x " Y1))
  30.   (command "TEXT" "c" cp "0" CPT "text" "" rmsz))
  31. (defun dtr (angg)
  32.   (* pi (/ angg 180.0)))